(in-package :leam)
(declaim (optimize (speed 0)(safety 3)(debug 3)))

(defclass leam-stream()
  ((current-id
    :initform 1
    :accessor current-id
    :documentation "Current message id")
   (un-ack
    :initform ()
    :accessor un-ack
    :documentation "Unacknowledged message ids")
   (un-fin
    :initform ()
    :accessor un-fin
    :documentation "Unfinished message ids")
   (stack-trace
    :initform (make-array 0 :adjustable t :element-type 'standard-char)
    :accessor stack-trace
    :documentation "Stack trace from the last error")
   (in-stream
    :initform nil
    :initarg :in-stream
    :accessor in-stream
    :documentation "Input stream to this leam-stream")
   (out-stream
    :initform nil
    :initarg :out-stream
    :accessor out-stream
    :documentation "Output stream to this leam-stream")
   (in-data-stream
    :initform (make-instance 'leam-data-in-stream)
    :accessor in-data-stream
    :documentation "Data input stream")
   (out-data-stream
    :initform (make-instance 'leam-data-out-stream)
    :accessor out-data-stream
    :documentation "Data output stream")
   (leam-handler
    :initform nil
    :initarg :leam-handler
    :accessor leam-handler
    :documentation "Handler for the stream")
   (enums
    :initform nil
    :initarg :enums
    :accessor enums
    :documentation "Enumerations used for communication.  See
grab-enumerations from cpp-integration.lisp in licada/common/lisp.")
   (message-handler-map
    :initform nil
    :initarg :message-handler-map
    :accessor message-handler-map
    :documentation "Assoc-list between message numbers and the
handling methods"))
  (:documentation "Main stream class.  Initialise with an input
stream, an output stream, and a handler.  The rest of the fields are
mainly just helpers for the class and not meant for external access"))

(defvar cpp-enum-path (merge-pathnames "../cpp/leam-enums.hh" *load-pathname*)
  "Defines where to find the enumerations the leam system requires")
(export 'cpp-enum-path)

;;read/write helpers
(defun read-type (stream)(read-unsigned-8 stream))
(defun write-type (stream type)(write-unsigned-8 stream type))
(defun read-id (stream)(read-unsigned-32 stream))
(defun write-id (stream id)(write-unsigned-32 stream id))
(defun read-length (stream)(read-unsigned-32 stream))
(defun write-length (stream len)(write-unsigned-32 stream len))

(defgeneric begin-send-message( leam-stream length )
  (:documentation "Begin to send a leam message.  Returns
values msgId outStream")
  (:method (leam-stream length)
    (with-accessors
	((un-ack un-ack)(un-fin un-fin)(enums enums)
	  (out-stream out-stream)(outds out-data-stream)
	 (current-id current-id))
      leam-stream
      (let ((cid current-id))
	(write-type out-stream
			  (enum-value :|ELeamType| :|ELeamTypeMessage| enums))
	(write-id out-stream cid)
	(write-length out-stream length)
	(setf current-id (+ current-id 1))
	(setup-data-stream outds length out-stream)
	(push cid un-ack)
	(push cid un-fin)
	(values cid outds)))))
(export 'begin-send-message)
        
(defgeneric read-next( leam-stream )
  (:documentation "Read the next method coming from the in-stream")
  (:method (leam-stream)
    (with-accessors ((ins in-stream)
		     (msg-map message-handler-map))
      leam-stream
      (let* ((type (read-type ins))
	     (handler (cdr(assoc type msg-map))))
	(unless handler
	  (error 'unrecognized-leam-message))
	(format t "message type: ~S~%" type )
	(funcall handler leam-stream)))))
(export 'read-next)

(defgeneric is-ack( leam-stream msg-id)
  (:documentation "Check to see if a message has been acknowledged")
  (:method (leam-stream msg-id) (not(null (member msg-id (un-ack leam-stream))))))
(export 'is-ack)

(defgeneric is-fin( leam-stream msg-id)
  (:documentation "Check to see if a message processing has finished")
  (:method (leam-stream msg-id) (not(null (member msg-id (un-fin leam-stream))))))
(export 'is-fin)

(defgeneric close-leam-stream(leam-stream)
  (:documentation "Send the close message and close the streams")
  (:method (leam-stream)
    (with-accessors
	((ins in-stream)(outs out-stream) (enums enums))
      leam-stream
      (write-type outs (enum-value :|ELeamType| :|ELeamTypeClosed| enums))
      (leam-finish-output outs)
      (leam-close outs)
      (leam-close ins)
      (setf outs nil)
      (setf ins nil))))
(export 'close-leam-stream)

;;Specific message handling methods

(defun handle-message( leam-stream )
  (with-accessors ((ins in-stream)(outs out-stream)(current-id current-id)
		   (enums enums)(un-ack un-ack)(un-fin un-fin)
		   (inds in-data-stream)(handler leam-handler))
    leam-stream
    (let ((msgId (read-id ins))
	  (msg-len (read-length ins)))
      (write-type outs (enum-value :|ELeamType| :|ELeamTypeAck| enums))
      (write-id outs msgId)
      (leam-finish-output outs)
      (setup-data-stream inds msg-len ins)
      (on-handle-data handler msgId inds)
      (ignore-data inds (get-remaining inds))
      (write-type outs (enum-value :|ELeamType| :|ELeamTypeFinished| enums))
      (write-id outs msgId)
      (leam-finish-output outs))))

(defun handle-ack-type-message( id-list msgId )
  (remove-if (lambda (item)(= msgId item)) id-list))

(defun handle-ack( leam-stream )
  (with-accessors
      ((un-ack un-ack)(handler leam-handler))
    leam-stream
    (let ((msg-id (read-id (in-stream leam-stream))))
      (setf un-ack (handle-ack-type-message un-ack msg-id))
      (format t "Sending ack ~%" )
      (on-handle-ack handler msg-id ))))

(defun handle-fin( leam-stream )
  (with-accessors
      ((un-fin un-fin) (handler leam-handler))
    leam-stream
    (let ((msg-id (read-id (in-stream leam-stream))))
      (setf un-fin (handle-ack-type-message un-fin msg-id))
      (on-handle-fin handler msg-id ))))

(defun handle-error( leam-stream )
  (with-accessors
      ((ins in-stream)(outs out-stream)
       (inds in-data-stream)(handler leam-handler)
       (st stack-trace)(un-fin un-fin)(un-ack un-ack))
    leam-stream
    (let ((msg-id (read-id ins))
	  (len (read-length ins))
	  (str-len (read-length ins)))
      (adjust-array st str-len :fill-pointer str-len)
      (read-char-string ins st)
      (setup-data-stream inds (- len str-len) ins)
      (on-handle-error handler msg-id st inds)
      (ignore-data inds (get-remaining inds))
      (setf un-ack (handle-ack-type-message un-ack msg-id))
      (setf un-fin (handle-ack-type-message un-fin msg-id)))))

(defun handle-close( leam-stream )
  (with-accessors
      ((handler leam-handler))
    leam-stream
    (on-handle-close handler)))

(defun initialize-leam-stream(leam-stream in-stream out-stream handler
			      &key (check-version t) (in-enums nil))
  "Initialize a created leam stream"
  (with-slots
	((ins in-stream) (outs out-stream) leam-handler
	 (item-enums enums) message-handler-map)
      leam-stream
    (let* ((enums (if in-enums in-enums (grab-enumerations cpp-enum-path)))
	   (msg-map (list
		     (cons (enum-value :|ELeamType| :|ELeamTypeMessage| enums)
			   #'handle-message)
		     (cons (enum-value :|ELeamType| :|ELeamTypeAck| enums)
			   #'handle-ack)
		     (cons (enum-value :|ELeamType| :|ELeamTypeFinished| enums)
			   #'handle-fin)
		     (cons (enum-value :|ELeamType| :|ELeamTypeError| enums)
			   #'handle-error)
		     (cons (enum-value :|ELeamType| :|ELeamTypeClosed| enums)
			   #'handle-close))))
      (setf ins in-stream)
      (setf outs out-stream)
      (setf leam-handler handler)
      (setf message-handler-map msg-map)
      (setf item-enums enums)
      (when check-version
	(let* ((cur-ver (enum-value :|ELeamVersion| :|ELeamVersionCurrent| enums)))
	  (write-unsigned-16 out-stream cur-ver)
	  (leam-finish-output out-stream)
	  (unless (= cur-ver (read-unsigned-16 in-stream))
	    (error 'leam-version-mismatch)))))))
	  
(defun make-leam-stream (in-stream out-stream handler
			 &key (check-version t) (in-enums nil))
  "Create a leam stream.  in-stream and out-stream may be standard
lisp binary streams, handler is user data.  Callbacks are listed in
leam-handler.lisp"
  (let ((retval (make-instance 'leam-stream)))
    (initialize-leam-stream retval in-stream out-stream handler
			    :check-version check-version
			    :in-enums in-enums)
    retval ))
(export 'make-leam-stream)
